home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus 2000 #5 / Amiga Plus CD - 2000 - No. 5.iso / Tools / Dev / fpc / source / demo / text / magic.pp < prev    next >
Encoding:
Text File  |  2000-01-01  |  2.5 KB  |  108 lines
  1. {
  2.     $Id: magic.pp,v 1.1 2000/03/09 02:49:09 alex Exp $
  3.     This file is part of the Free Pascal run time library.
  4.     Copyright (c) 1993-98 by Florian Klaempfl
  5.  
  6.     Magic Square Example
  7.  
  8.     See the file COPYING.FPC, included in this distribution,
  9.     for details about the copyright.
  10.  
  11.     This program is distributed in the hope that it will be useful,
  12.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  14.  
  15.  **********************************************************************}
  16. program magic;
  17.  
  18. {
  19.   Calculate a magic square (sum of the row, colums and diagonals is equal
  20. }
  21.  
  22.   const
  23.      maxsize = 11;
  24.  
  25.   type
  26.      sqrtype = array[1..maxsize, 1..maxsize] of longint;
  27.  
  28.   var
  29.      square : sqrtype;
  30.      size, row, sum : longint;
  31.  
  32.   procedure makesquare(var sq : sqrtype;limit : longint);
  33.  
  34.     var
  35.        num,r,c : longint;
  36.  
  37.     begin
  38.        for r:=1 to limit do
  39.          for c:=1 to limit do
  40.            sq[r, c] := 0;
  41.        if (limit and 1)<>0 then
  42.          begin
  43.             r:=(limit+1) div 2;
  44.             c:=limit;
  45.             for num:=1 to limit*limit do
  46.               begin
  47.                  if sq[r,c]<>0 then
  48.                    begin
  49.                       dec(r);
  50.                       if r<1 then
  51.                         inc(r,limit);
  52.                       dec(c,2);
  53.                       if c<1 then
  54.                         inc(c,limit);
  55.                    end;
  56.                  sq[r,c]:=num;
  57.                  inc(r);
  58.                  if r>limit then
  59.                    dec(r,limit);
  60.                  inc(c);
  61.                  if c>limit then
  62.                    dec(c,limit);
  63.               end;
  64.          end;
  65.      end;
  66.  
  67.   procedure writesquare(var sq : sqrtype;limit : longint);
  68.  
  69.     var
  70.        row,col : longint;
  71.  
  72.     begin
  73.        for row:=1 to Limit do
  74.          begin
  75.             for col:=1 to (limit div 2) do
  76.               write(sq[row,2*col-1]:4,' ',sq[row,2*col]:4,' ');
  77.             writeln(sq[row,limit]:4);
  78.          end;
  79.     end;
  80.  
  81. begin
  82.   size:=3;
  83.   while (size<=maxsize) do
  84.     begin
  85.        writeln('Magic Square with size ',size);
  86.        writeln;
  87.        makesquare(square,size);
  88.        writesquare(square,size);
  89.        writeln;
  90.        sum:=0;
  91.        for row:=1 to size do
  92.          inc(sum,square[row,1]);
  93.        writeln('Sum of the rows,columns and diagonals = ', sum);
  94.        writeln;
  95.        writeln;
  96.        inc(size,2);
  97.     end;
  98. end.
  99. {
  100.   $Log: magic.pp,v $
  101.   Revision 1.1  2000/03/09 02:49:09  alex
  102.   moved files
  103.  
  104.   Revision 1.2  1998/09/11 10:55:24  peter
  105.     + header+log
  106.  
  107. }
  108.